home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-bag.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-10-13  |  3.2 KB  |  123 lines
  1. /*  $Id: pl-bag.c,v 1.15 1997/10/13 10:08:31 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Support predicates for bagof
  8. */
  9.  
  10. /*#define O_SECURE 1*/
  11. #include "pl-incl.h"
  12.  
  13. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  14. This module defines support  predicates  for  the  Prolog  all-solutions
  15. predicates findall/3, bagof/3 and setof/3.  These predicates are:
  16.  
  17.     $record_bag(Key, Value)        Record a value under a key.
  18.         $collect_bag(Bindings, Values)    Retract all Solutions matching
  19.                     Bindings.
  20.  
  21. The (toplevel) remainder of the all-solutions predicates is  written  in
  22. Prolog.
  23. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  24.  
  25. struct assoc
  26. { Record    binding;
  27.   Assoc        next;            /* next in chain */
  28. };
  29.  
  30. #define alist LD->bags.bags        /* Each thread has its own */
  31.                     /* storage for this */
  32.  
  33. static
  34. void
  35. freeAssoc(Assoc prev, Assoc a)
  36. { if ( prev == NULL )
  37.     alist = a->next;
  38.   else
  39.     prev->next = a->next;
  40.   if ( a->binding )
  41.     freeRecord(a->binding);
  42.   freeHeap(a, sizeof(struct assoc));
  43. }
  44.  
  45. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  46. $record_bag(Key-Value)
  47.  
  48. Record a solution of bagof.  Key is a term  v(V0,  ...Vn),  holding  the
  49. variable binding for solution `Gen'.  Key is ATOM_mark for the mark.
  50. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  51.  
  52. word
  53. pl_record_bag(term_t t)
  54. { Assoc a = (Assoc) allocHeap(sizeof(struct assoc));
  55.  
  56.   if ( PL_is_atom(t) )
  57.     a->binding = NULL;
  58.   else
  59.     a->binding = compileTermToHeap(t);
  60.   a->next    = alist;
  61.   alist       = a;
  62.  
  63.   succeed;
  64. }
  65.  
  66. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  67. This predicate will fail if no more records are left before the mark.
  68. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  69.  
  70. word
  71. pl_collect_bag(term_t bindings, term_t bag)
  72. { term_t var_term = PL_new_term_ref();    /* v() term on global stack */
  73.   term_t list     = PL_new_term_ref();    /* list to construct */
  74.   term_t binding  = PL_new_term_ref();    /* current binding */
  75.   term_t tmp      = PL_new_term_ref();
  76.   Assoc a, next;
  77.   Assoc prev = (Assoc) NULL;
  78.   
  79.   if ( !(a = alist) )
  80.     fail;
  81.   if ( !a->binding )
  82.   { freeAssoc(prev, a);
  83.     fail;                /* trapped the mark */
  84.   }
  85.  
  86.   PL_put_nil(list);
  87.                     /* get variable term on global stack */
  88.   copyRecordToGlobal(binding, a->binding);
  89.   PL_get_arg(1, binding, var_term);
  90.   PL_unify(bindings, var_term);
  91.   PL_get_arg(2, binding, tmp);
  92.   PL_cons_list(list, tmp, list);
  93.  
  94.   next = a->next;
  95.   freeAssoc(prev, a);  
  96.  
  97.   if ( next != NULL )
  98.   { for( a = next, next = a->next; next; a = next, next = a->next )
  99.     { if ( !a->binding )
  100.     break;
  101.  
  102.       if ( !structuralEqualArg1OfRecord(var_term, a->binding) )
  103.       { prev = a;
  104.     continue;
  105.       }
  106.  
  107.       copyRecordToGlobal(binding, a->binding);
  108.       PL_get_arg(1, binding, tmp);
  109.       PL_unify(tmp, bindings);
  110.       PL_get_arg(2, binding, tmp);
  111.       PL_cons_list(list, tmp, list);
  112.       SECURE(checkData(&list));
  113.       freeAssoc(prev, a);
  114.     }
  115.   }
  116.  
  117.   SECURE(checkData(valTermRef(var_term)));
  118.  
  119.   return PL_unify(bag, list);
  120. }
  121.  
  122.  
  123.